perm filename BGBMAT[1,LMM]1 blob
sn#031699 filedate 1973-03-28 generic text, type T, neo UTF8
(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
T)
(LISPXPRIN1 (QUOTE "28-MAR-73 03:03:51")
T)
(LISPXTERPRI T))
(LISPXPRINT (QUOTE BGBMATCHVARS)
T)
(RPAQQ BGBMATCHVARS
((RECORD SUBGRAPH)
(FNS APPREV ASSIGN ASSIGNFAIL DISJOINT DOTS DOTSCHECK EQSET
EXAMPLETYPE FILTERASSIGN HYDROGENS INVALID ISIT
LESSLENGTH LIKE NBRSCHECK NEIGHBORS NHSCHECK NORMSUBG
ONEP PRINTLREC PRUNEASSIGN RECDEF STRUCTURE-SUBGRAPH
SUBMATCH SUBMATCH1 SUBSETP TYPE UORDER)
(VARS ALDEHYDE AMINE BIGGRAPH DARING DARING1 DARINGLIST
DARINGSUB1 ETHER ETHERRING KETONE MAPPING MATCHNUM
OXIME RINGX RINGY STRUCTURE SUBGRAPH TEST2 THIOETHER
THIOL MATCHTESTLIST)))
(DEFLIST(QUOTE(
(SUBGRAPH (SUBNODE SUBTYPE SUBNBRS SUBDOTS SUBNHS SUBXDOTS SUBXNHS))
))(QUOTE RECORD))
(RECORD (QUOTE SUBGRAPH))
(DEFINEQ
(APPREV
[LAMBDA (L1 L2)
(APPEND (REVERSE L1)
L2])
(ASSIGN
[LAMBDA (SUB BIG MLIST)
(PROG (X1 B1 ASGN)
A (COND
((NULL SUB)
(RETURN ASGN)))
(SETQ X1 (CAR SUB))
(SETQ SUB (CDR SUB))
[SETQ B1 (SUBSET BIG (FUNCTION (LAMBDA (U)
(* Makes a preliminary assignment of atoms of SUB to
BIG -
Using the set of tests given as MLIST
(which is a list of function names) -
If the MLIST is NIL then the global variable
MATCHTESTLIST will be used)
(LIKE X1 U MLIST]
(COND
((NULL B1)
(RETURN NIL)))
(SETQ ASGN (CONS (CONS X1 B1)
ASGN))
(GO A])
(ASSIGNFAIL
[LAMBDA (ASGN)
(ONEP (LENGTH (CAR ASGN])
(DISJOINT
[LAMBDA (L1 L2)
(FOR NEW X IN L1 WHEN (NOT (MEMBER X L2))
LIST X])
(DOTS
[LAMBDA (A)
(* Gives the number of DOTS
(OR EQUIVALENT THEREOF) of A node of the BIGGRAPH)
(COND
(DOTNOTATION (ERROR "NOT IMPLEMENTED YET"))
(T (FOR A ON A WHEN (AND (NOT (EQ (CAR A)
(QUOTE FV)))
(MEMBER (CAR A)
(CDR A)))
PLUS 1])
(DOTSCHECK
[LAMBDA (SUB BIG) (* This FN can be made a
member of MATCHTESTLIST)
(IF (SUBXDOTS SUB)
THEN (EQUAL (DOTS BIG)
(SUBXDOTS SUB))
ELSE (LEQ (SUBDOTS SUB)
(DOTS BIG])
(EQSET
[LAMBDA (L1 L2)
(AND (SUBSETP L1 L2)
(SUBSETP L2 L1])
(EXAMPLETYPE
[LAMBDA (SUBTYP BIGTYP)
(* Checks for equivalence (or satisfaction of
nominal requirements-) for atom types of bigatom and
subatom)
(SETQ BIGTYP (TYPE BIGTYP))
(SETQ SUBTYP (SUBTYPE SUBTYP))
(COND
((ATOM SUBTYP)
(EQ BIGTYP SUBTYP))
(T (MEMBER BIGTYP SUBTYP])
(FILTERASSIGN
[LAMBDA (SUB BIG KNOWN)
(* Takes off the assignment list those not
compatible in the light of matchings already made)
(PROG (KN S1 VAL NSUB)
(SETQ KN KNOWN)
A (COND
((OR (ATOM KN)
(ATOM SUB))
(GO C)))
(SETQ S1 (CAR SUB))
(SETQ SUB (CDR SUB))
(SETQ VAL (SASSOC (CAR S1)
KN NIL))
(COND
(VAL (GO B)))
(SETQ NSUB (CONS S1 NSUB))
(GO A)
B (COND
((NOT (LIKE S1 (CDR VAL)))
(RETURN NIL)))
(SETQ KN (REMOVE KN VAL))
(GO A)
C (SETQ NSUB (APPREV SUB NSUB))
(COND
((ATOM NSUB)
(RETURN T)))
[SETQ BIG (DISJOINT BIG (MAPCAR KNOWN (FUNCTION CDR]
(COND
((LESSP (LENGTH BIG)
(LENGTH NSUB))
(RETURN NIL)))
(RETURN (ASSIGN NSUB BIG])
(HYDROGENS
[LAMBDA (BIGATOM)
(* Needs redefinition WHEN a different or
alternative manner of representing HYDROGENS is
devised)
(FOR NEW N IN (NBRS BIGATOM) WHEN (EQ N (QUOTE FV))
PLUS 1])
(INVALID
[LAMBDA (PR OLDMAP)
(* Believe that this function is the one that
assures the topological MAPPING between the SUBGRAPH
and BIGGRAPH by doing the detailed atom by atom
CHECK of the preservation of adjacency
(OR NEIGHBORHOOD) requirement)
(PROG (B1 OLDB S1 NS NB X1)
(COND
((NULL OLDMAP)
(RETURN NIL)))
(SETQ B1 (CDR PR))
(COND
([MEMBER B1 (SETQ OLDB (MAPCAR OLDMAP
(FUNCTION CDR]
(RETURN T)))
(SETQ S1 (CAR PR))
(SETQ NS (SUBNBRS S1))
(SETQ NB (NEIGHBORS B1))
(SETQ X1 NB)
[SETQ NB (SUBSET OLDMAP (FUNCTION (LAMBDA (U)
(MEMBER (CDR U)
X1]
(SETQ X1 NS)
[SETQ NS (SUBSET OLDMAP (FUNCTION (LAMBDA (U)
(MEMBER (CAR U)
X1]
(COND
((EQSET NB NS)
(RETURN NIL)))
(RETURN T])
(ISIT
[LAMBDA (SUBGRAPH BIGGRAPH)
(* The toplevel function -- has now the flexibility
to supply the testlist to be used in making the
assignments)
(* (only one match will be tried -- and true or
false determined from that))
(SUBMATCH SUBGRAPH BIGGRAPH 1])
(LESSLENGTH
[LAMBDA (L1 L2)
(NOT (GREATERP (LENGTH L1)
(LENGTH L2])
(LIKE
[LAMBDA (SUBATOM BIGATOM MLIST)
(FOR NEW TEST IN (OR MLIST MATCHTESTLIST)
AND (APPLY* TEST SUBATOM BIGATOM])
(NBRSCHECK
[LAMBDA (SUB BIG)
(LEQ (LENGTH (SUBNBRS SUBATOM))
(LENGTH (NEIGHBORS BIGATOM])
(NEIGHBORS
[LAMBDA (A)
(MAPCAR (NBRS A)
(FUNCTION (LAMBDA (X)
(COND
((NOT (EQ (QUOTE FV)
X))
(FINDCTE X STRUCTURE])
(NHSCHECK
[LAMBDA (SUB BIG)
(IF (SUBXNHS SUB)
THEN (EQUAL (HYDROGENS BIG)
(SUBXNHS SUB))
ELSE (LEQ (SUBNHS SUB)
(HYDROGENS BIG])
(NORMSUBG
[LAMBDA (SUB)
(* Throws a SUBGRAPH from a non-standard def to the
FORM as per RECORD definition of SUBGRAPH)
(* Will CHANGE when the
RECORD definition
alters)
(FOR NEW S IN SUB LIST (SUBGRAPH FROM S SUBNHS (COND
((SUBNHS S))
(T 0))
SUBDOTS
(COND
((SUBDOTS S))
(T 0])
(ONEP
[LAMBDA (N)
(EQP N 1])
(PRINTLREC
[LAMBDA (REC VAL)
(* First argument is the atom , the name of a RECORD
-- the second argument is a list
(not just one RECORD -
You can use PRINTREC for that) and loops thru and
calls PRINTREC)
(FOR NEW R IN VAL DO (PRINTREC REC R)
(PRINT "=========================")
(TERPRI])
(PRUNEASSIGN
[LAMBDA (SUB BIGS OLDMAP BG) (* Will have to ask
buchanan or look up his
documentation)
(PROG (X1 NMAP NB NNB)
(SETQ X1 (SUBNBRS SUB))
[SETQ NMAP (SUBSET OLDMAP (FUNCTION (LAMBDA (U)
(MEMBER (CAR U)
X1]
(COND
((NULL NMAP)
(RETURN BIGS)))
(SETQ NB (INTERSECTION NB NB))
(SETQ NB (MAPCAR NMAP (FUNCTION CDR)))
(SETQ NNB (MAPCONC NB (FUNCTION NEIGHBORS)))
(RETURN (INTERSECTION BIGS NNB])
(RECDEF
[LAMBDA (X)
(OR (GETP X (QUOTE RECORD))
(GETP X (QUOTE !RECORD])
(STRUCTURE-SUBGRAPH
[LAMBDA (STRUC)
(FOR NEW CT IN (CTABLE STRUC)
XLIST
(SUBGRAPH SUBNODE =(NODENUM CT)
SUBTYPE =(TYPE CT)
SUBNBRS =(NBRS CT)
SUBDOTS =(DOTS CT)
SUBNHS =(HYDROGENS CT)
SUBXNHS =(RP (LIST '(EXACT NHS FOR)
(NODENUM CT)))
SUBXDOTS =(RP (LIST '(EXACT DOTS FOR)
(NODENUM CT])
(SUBMATCH
[LAMBDA (SUBGRAPH STRUC M)
(PROG (ASSGN)
(GSET (QUOTE MATCHNUM)
M)
(GSET (QUOTE STRUCTURE)
(COND
((STRUCTURE? STRUC)
(SETQ STRUC (CTABLE STRUC)))
(T STRUC)))
(SETQ MAPPINGLIST NIL)
(SETQ ASSGN (UORDER (FILTERASSIGN SUBGRAPH STRUC MAPPING)))
[COND
((NULL ASSGN)
(RETURN NIL))
((ATOM ASSGN)
(RETURN (SETQ MAPPINGLIST (LIST MAPPING]
(SUBMATCH1 (CAR ASSGN)
MAPPING
(CDR ASSGN)
STRUC)
(RETURN MAPPINGLIST])
(SUBMATCH1
[LAMBDA (NEWASSUME KNOWN POSSMAP BG)
(PROG (NEWA1 ANS)
(SETQ NEWASSUME (CONS (CAR NEWASSUME)
(PRUNEASSIGN (CAR NEWASSUME)
(CDR NEWASSUME)
KNOWN BG)))
A (COND
((NULL (CDR NEWASSUME))
(RETURN NIL)))
(SETQ NEWA1 (CONS (CAR NEWASSUME)
(CADR NEWASSUME)))
(SETQ NEWASSUME (CONS (CAR NEWASSUME)
(CDDR NEWASSUME)))
(COND
((INVALID NEWA1 KNOWN)
(GO A)))
(COND
((NULL POSSMAP)
(GO B)))
(SETQ ANS (SUBMATCH1 (CAR POSSMAP)
(CONS (CONS (CAAR NEWA1)
(CDR NEWA1))
KNOWN)
(CDR POSSMAP)
BG))
(COND
((NULL ANS)
(GO A)))
(RETURN ANS)
B (SETQ MATCHNUM (SUB1 MATCHNUM))
(SETQ MAPPINGLIST (CONS (CONS (CONS (CAAR NEWA1)
(CDR NEWA1))
KNOWN)
MAPPINGLIST))
(COND
((ZEROP MATCHNUM)
(RETURN MAPPINGLIST)))
(GO A])
(SUBSETP
[LAMBDA (L1 L2)
(FOR NEW X IN L1 AND (MEMBER X L2])
(TYPE
[LAMBDA (A)
(ATOMTYPE (MARKERS A])
(UORDER
[LAMBDA (ASGN)
(* Sorts the atoms of SUBGRAPH according to
increasing sets of possible MAPPING BIGGRAPH atoms--
believe this helps in finding non-matches quicker)
(PROG (ANS)
(SETQ ANS (SORT ASGN (FUNCTION LESSLENGTH)))
(COND
((ASSIGNFAIL ANS)
(RETURN NIL)))
(RETURN ANS])
)
(RPAQQ ALDEHYDE ((1 C (2)
1 0 NIL 1)
(2 O (1)
1 0 NIL NIL)))
(RPAQQ AMINE ((1 N NIL 0 0 NIL NIL)))
(RPAQQ BIGGRAPH NIL)
[RPAQQ DARING (STRUCTURE ((CTENTRY 1 (NIL)
6 2 2)
(CTENTRY 2 (NIL)
3 1 1)
(CTENTRY 6 (NIL)
1 5)
(CTENTRY 5 (NIL)
6 4)
(CTENTRY 4 (NIL)
5 3)
(CTENTRY 3 (NIL)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2))
((3 4 5 6)
(2 1]
[RPAQQ DARING1 (STRUCTURE ((CTENTRY 1 (N)
6 2 2)
(CTENTRY 2 (C)
3 1 1)
(CTENTRY 6 (N)
1 5)
(CTENTRY 5 (N)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2]
[RPAQQ DARINGLIST ((STRUCTURE ((CTENTRY 1 (N)
6 2 2)
(CTENTRY 2 (C)
3 1 1)
(CTENTRY 6 (N)
1 5)
(CTENTRY 5 (C)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2)))
(STRUCTURE ((CTENTRY 1 (C)
6 2 2)
(CTENTRY 2 (N)
3 1 1)
(CTENTRY 6 (N)
1 5)
(CTENTRY 5 (C)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2)))
(STRUCTURE ((CTENTRY 1 (N)
6 2 2)
(CTENTRY 2 (C)
3 1 1)
(CTENTRY 6 (C)
1 5)
(CTENTRY 5 (N)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2)))
(STRUCTURE ((CTENTRY 1 (C)
6 2 2)
(CTENTRY 2 (N)
3 1 1)
(CTENTRY 6 (C)
1 5)
(CTENTRY 5 (N)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2]
(RPAQQ DARINGSUB1 ((1 N (6 2 2)
0 0)
(2 C (3 1 1)
0 0)
(6 N (1 5)
0 0)
(5 N (6 4)
0 0)
(4 C (5 3)
0 0)
(3 C (2 4)
0 0)))
(RPAQQ ETHER ((1 O NIL NIL 0 0 0)))
[RPAQQ ETHERRING (STRUCTURE ((CTENTRY 1 (C)
6 2 2)
(CTENTRY 2 (C)
3 1 1)
(CTENTRY 6 (O)
1 5)
(CTENTRY 5 (C)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4))
(MBONDS . 3)
6
((6 5 4 3)
(1 2]
(RPAQQ KETONE ((1 C (2)
1 0 NIL 0)
(2 O (1)
1 0 NIL NIL)))
(RPAQQ MAPPING NIL)
(RPAQQ MATCHNUM 0)
(RPAQQ OXIME ((1 C (2)
1 NIL NIL NIL)
(2 N (1 3)
1 NIL NIL NIL)
(3 O (2)
NIL NIL 0 NIL)))
[RPAQQ RINGX (STRUCTURE ((CTENTRY 4 (C)
1 3 FV FV)
(CTENTRY 3 (C)
4 2 FV FV)
(CTENTRY 2 (N)
3 1 FV)
(CTENTRY 1 (N)
4 2 FV))
(SINGLERING . 4)
4
((4 3 2 1))
((3 4 1 2]
[RPAQQ RINGY (STRUCTURE ((CTENTRY 4 (C)
1 3 FV FV)
(CTENTRY 3 (N)
4 2 FV)
(CTENTRY 2 (C)
3 1 FV FV)
(CTENTRY 1 (N)
4 2 FV))
(SINGLERING . 4)
4
((4 3 2 1))
((2 3 4 1))
((4 1 2 3))
((2 1 4 3]
(RPAQQ STRUCTURE ((CTENTRY 1 (N)
6 2 2)
(CTENTRY 2 (C)
3 1 1)
(CTENTRY 6 (N)
1 5)
(CTENTRY 5 (N)
6 4)
(CTENTRY 4 (C)
5 3)
(CTENTRY 3 (C)
2 4)))
(RPAQQ SUBGRAPH ((1 N (2)
0 1 NIL NIL)
(2 N (1)
0 1 NIL NIL)))
(RPAQQ TEST2 ((1 N (4 2)
0 1 NIL NIL)
(2 N (1 3)
0 1 NIL NIL)
(3 C (4 2)
0 2 NIL NIL)
(4 C (1 3)
0 2 NIL NIL)))
(RPAQQ THIOETHER ((1 S NIL NIL 0 0 0)))
(RPAQQ THIOL ((1 C (2)
NIL 0 NIL NIL)
(2 S (1)
NIL 1 NIL NIL)))
(RPAQQ MATCHTESTLIST (EXAMPLETYPE NBRSCHECK NHSCHECK DOTSCHECK))
STOP